home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Visual Basic 4 Database How-To
/
Visual Basic 4 Database - How-to (The Waite Group)(1995).iso
/
dde.ba_
/
dde.ba
Wrap
Text File
|
1995-07-05
|
2KB
|
62 lines
Attribute VB_Name = "Module1"
Option Explicit
' Declare the Windows API function GetProfileString
' The #IF logic makes sure the correct function is declared
' based on whether you are using a 16-bit or 32-bit environment.
#If Win32 Then
Declare Function GetProfileString Lib "kernel32" Alias "GetProfileStringA" _
(ByVal lpAppName As String, ByVal lpKeyName As String, _
ByVal lpDefault As String, ByVal lpReturnedString As String, _
ByVal nSize As Long) As Long
#Else
Declare Function GetProfileString Lib "Kernel" (ByVal lpAppName$, _
ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnString As String, _
ByVal nSize As Integer) As Integer
#End If
Function AccessPath() As String
Const MAXPATHLENGTH = 128
Dim lpAppName As String
Dim lpKeyName As String
Dim lpDefault As String
Dim lpReturnString As String * MAXPATHLENGTH
Dim nSize As Integer
Dim pathLength As Integer
Dim thePath As String
Dim endOfPath As Integer
' Set the parameters to pass to GetProfileString.
lpAppName = "Extensions"
lpKeyName = "MDB"
lpDefault = ""
nSize = MAXPATHLENGTH
' Call GetProfileString. It puts the pathname (if it finds it) into
' the lpReturnString argument and returns the length of the path name.
pathLength = GetProfileString(lpAppName, lpKeyName, lpDefault, _
lpReturnString, nSize)
If pathLength > 0 Then
' We have a path name, but it probably includes at the end a
' space followed by ^.MDB. If that's the case, strip off the
' extraneous extra stuff.
thePath = Left$(lpReturnString, pathLength)
endOfPath = InStr(thePath, " ") - 1
' Return the pathname to the calling routine.
If endOfPath > 0 Then
AccessPath = Left$(thePath, endOfPath)
Else
AccessPath = thePath
End If
Else
' We found no path, so return an empty string.
AccessPath = ""
End If
End Function